home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HyperLib 1997 Winter - Disc 1
/
HYPERLIB-1997-Winter-CD1.ISO.7z
/
HYPERLIB-1997-Winter-CD1.ISO
/
オンラインウェア
/
PRG
/
Mac_F2C_1.3.2.sit
/
Mac F2C 1.3.2
/
Test Project ƒ
/
test.cp (C++ Output)
< prev
next >
Wrap
Text File
|
1996-06-24
|
18KB
|
588 lines
/* test.f -- translated by f2c (version 19941113).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#ifdef __cplusplus
extern "C" {
#endif
#include "f2c.h"
/* Table of constant values */
static integer c__9 = 9;
static integer c__1 = 1;
static integer c__10 = 10;
static integer c__3 = 3;
static integer c__4 = 4;
static integer c__5 = 5;
static doublereal c_b152 = .33333333333333331;
/* Main program */ MAIN__()
{
/* Format strings */
static char fmt_99[] = "(a1)";
/* Builtin functions */
integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
e_wsle(), s_rsfe(cilist *), do_fio(integer *, char *, ftnlen),
e_rsfe();
/* Subroutine */ int s_stop(char *, ftnlen);
/* Local variables */
static char junk[2];
extern /* Subroutine */ int alg_test__(integer *), i_o_test__(),
flt_test__(integer *), int_test__(integer *), trn_test__();
/* Fortran I/O blocks */
static cilist io___1 = { 0, 6, 0, 0, 0 };
static cilist io___2 = { 0, 6, 0, 0, 0 };
static cilist io___3 = { 0, 5, 0, fmt_99, 0 };
static cilist io___5 = { 0, 6, 0, 0, 0 };
static cilist io___6 = { 0, 6, 0, 0, 0 };
static cilist io___7 = { 0, 5, 0, fmt_99, 0 };
static cilist io___8 = { 0, 6, 0, 0, 0 };
static cilist io___9 = { 0, 6, 0, 0, 0 };
static cilist io___10 = { 0, 5, 0, fmt_99, 0 };
static cilist io___11 = { 0, 6, 0, 0, 0 };
static cilist io___12 = { 0, 6, 0, 0, 0 };
static cilist io___13 = { 0, 5, 0, fmt_99, 0 };
static cilist io___14 = { 0, 6, 0, 0, 0 };
static cilist io___15 = { 0, 6, 0, 0, 0 };
static cilist io___16 = { 0, 5, 0, fmt_99, 0 };
static cilist io___17 = { 0, 6, 0, 0, 0 };
/* This is a FORTRAN program to test Mac F2C v1.1 */
s_wsle(&io___1);
do_lio(&c__9, &c__1, "***** Input/Output Test *****", 33L);
e_wsle();
i_o_test__();
s_wsle(&io___2);
do_lio(&c__9, &c__1, "¥n***** End of I/O test, hit return to continue.¥
..", 51L);
e_wsle();
s_rsfe(&io___3);
do_fio(&c__1, junk, 2L);
e_rsfe();
s_wsle(&io___5);
do_lio(&c__9, &c__1, "¥n***** Integer Math Test *****", 34L);
e_wsle();
int_test__(&c__10);
s_wsle(&io___6);
do_lio(&c__9, &c__1, "¥n***** End of integer math test, hit return to ¥
continue...", 60L);
e_wsle();
s_rsfe(&io___7);
do_fio(&c__1, junk, 2L);
e_rsfe();
s_wsle(&io___8);
do_lio(&c__9, &c__1, "¥n***** Floating Point Math Test *****", 41L);
e_wsle();
flt_test__(&c__10);
s_wsle(&io___9);
do_lio(&c__9, &c__1, "¥n***** End of floating point math test, hit ret¥
urn to continue...", 67L);
e_wsle();
s_rsfe(&io___10);
do_fio(&c__1, junk, 2L);
e_rsfe();
s_wsle(&io___11);
do_lio(&c__9, &c__1, "¥n***** Algebraic Function Test *****", 40L);
e_wsle();
alg_test__(&c__10);
s_wsle(&io___12);
do_lio(&c__9, &c__1, "¥n***** End of algebraic function test, hit retu¥
rn to continue...", 66L);
e_wsle();
s_rsfe(&io___13);
do_fio(&c__1, junk, 2L);
e_rsfe();
s_wsle(&io___14);
do_lio(&c__9, &c__1, "¥n***** Transcendental Function Test *****",
45L);
e_wsle();
trn_test__();
s_wsle(&io___15);
do_lio(&c__9, &c__1, "¥n***** End of transcendental function test, hit¥
return to continue...", 71L);
e_wsle();
s_rsfe(&io___16);
do_fio(&c__1, junk, 2L);
e_rsfe();
s_wsle(&io___17);
do_lio(&c__9, &c__1, "¥n***** This completes all of the tests *****",
48L);
e_wsle();
s_stop("", 0L);
return 0;
} /* MAIN__ */
/**************************************************************************/
/* Subroutine to do the I/O tests */
/**************************************************************************/
/* Subroutine */ int i_o_test__()
{
/* Format strings */
static char fmt_312[] = "(1x,¥002The number you entered was: ¥002,f13.6)";
static char fmt_313[] = "(1x,¥002The number you entered was: ¥002,f17.10)"
;
static char fmt_399[] = "(a1)";
static char fmt_304[] = "(5x,a20,5(i1,2x),5x,5(f4.2,2x))";
/* System generated locals */
olist o__1;
cllist cl__1;
/* Builtin functions */
integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
e_wsle(), s_rsle(cilist *), e_rsle(), s_wsfe(cilist *), do_fio(
integer *, char *, ftnlen), e_wsfe(), s_rsfe(cilist *), e_rsfe();
void s_copy(char *, char *, ftnlen, ftnlen);
integer f_open(olist *), s_wsue(cilist *), do_uio(integer *, char *,
ftnlen), e_wsue(), f_clos(cllist *), s_rsue(cilist *), e_rsue();
/* Local variables */
static char text[40];
static real a[5];
static integer i, j[5];
static real x;
static doublereal dx;
/* Fortran I/O blocks */
static cilist io___18 = { 0, 6, 0, 0, 0 };
static cilist io___19 = { 0, 5, 0, 0, 0 };
static cilist io___21 = { 0, 6, 0, 0, 0 };
static cilist io___22 = { 0, 6, 0, 0, 0 };
static cilist io___23 = { 0, 5, 0, 0, 0 };
static cilist io___25 = { 0, 6, 0, fmt_312, 0 };
static cilist io___26 = { 0, 6, 0, 0, 0 };
static cilist io___27 = { 0, 5, 0, 0, 0 };
static cilist io___29 = { 0, 6, 0, fmt_313, 0 };
static cilist io___30 = { 0, 6, 0, 0, 0 };
static cilist io___31 = { 0, 5, 0, 0, 0 };
static cilist io___33 = { 0, 6, 0, 0, 0 };
static cilist io___34 = { 0, 6, 0, 0, 0 };
static cilist io___35 = { 0, 5, 0, fmt_399, 0 };
static cilist io___38 = { 0, 60, 0, 0, 0 };
static cilist io___39 = { 0, 6, 0, 0, 0 };
static cilist io___40 = { 0, 6, 0, fmt_304, 0 };
static cilist io___41 = { 0, 50, 0, 0, 0 };
static cilist io___42 = { 0, 6, 0, 0, 0 };
static cilist io___43 = { 0, 6, 0, fmt_304, 0 };
/* Screen I/O tests */
s_wsle(&io___18);
do_lio(&c__9, &c__1, "¥nPart 1: Screen I/O tests.¥n¥nEnter an integer v¥
alue.", 52L);
e_wsle();
s_rsle(&io___19);
do_lio(&c__3, &c__1, (char *)&i, (ftnlen)sizeof(integer));
e_rsle();
s_wsle(&io___21);
do_lio(&c__9, &c__1, "The number you entered was:", 27L);
do_lio(&c__3, &c__1, (char *)&i, (ftnlen)sizeof(integer));
e_wsle();
s_wsle(&io___22);
do_lio(&c__9, &c__1, "¥nEnter a single precision floating point value...",
49L);
e_wsle();
s_rsle(&io___23);
do_lio(&c__4, &c__1, (char *)&x, (ftnlen)sizeof(real));
e_rsle();
s_wsfe(&io___25);
do_fio(&c__1, (char *)&x, (ftnlen)sizeof(real));
e_wsfe();
s_wsle(&io___26);
do_lio(&c__9, &c__1, "¥nEnter a double precision floating point value...",
49L);
e_wsle();
s_rsle(&io___27);
do_lio(&c__5, &c__1, (char *)&dx, (ftnlen)sizeof(doublereal));
e_rsle();
s_wsfe(&io___29);
do_fio(&c__1, (char *)&dx, (ftnlen)sizeof(doublereal));
e_wsfe();
s_wsle(&io___30);
do_lio(&c__9, &c__1, "¥nEnter some text (40 char max)...", 33L);
e_wsle();
s_rsle(&io___31);
do_lio(&c__9, &c__1, text, 40L);
e_rsle();
s_wsle(&io___33);
do_lio(&c__9, &c__1, "The text you entered was: ", 26L);
do_lio(&c__9, &c__1, text, 40L);
e_wsle();
s_wsle(&io___34);
do_lio(&c__9, &c__1, "¥nPart 2: file I/O tests. Hit return to continue¥
...", 52L);
e_wsle();
s_rsfe(&io___35);
do_fio(&c__1, text, 40L);
e_rsfe();
/* File I/O tests: Store some values and write them to file */
for (i = 1; i <= 5; ++i) {
j[i - 1] = i;
a[i - 1] = (doublereal) i;
}
s_copy(text, "A test message.", 40L, 15L);
o__1.oerr = 0;
o__1.ounit = 60;
o__1.ofnmlen = 8;
o__1.ofnm = "test.dat";
o__1.orl = 0;
o__1.osta = 0;
o__1.oacc = 0;
o__1.ofm = "unformatted";
o__1.oblnk = 0;
f_open(&o__1);
s_wsue(&io___38);
do_uio(&c__1, text, 40L);
do_uio(&c__5, (char *)&j[0], (ftnlen)sizeof(integer));
do_uio(&c__5, (char *)&a[0], (ftnlen)sizeof(real));
e_wsue();
cl__1.cerr = 0;
cl__1.cunit = 60;
cl__1.csta = 0;
f_clos(&cl__1);
s_wsle(&io___39);
do_lio(&c__9, &c__1, "Wrote the following data to file test.dat:¥n", 43L);
e_wsle();
s_wsfe(&io___40);
do_fio(&c__1, text, 40L);
for (i = 1; i <= 5; ++i) {
do_fio(&c__1, (char *)&j[i - 1], (ftnlen)sizeof(integer));
}
for (i = 1; i <= 5; ++i) {
do_fio(&c__1, (char *)&a[i - 1], (ftnlen)sizeof(real));
}
e_wsfe();
/* Reset the variables and read them back */
for (i = 1; i <= 5; ++i) {
j[i - 1] = 99;
a[i - 1] = (float)99.;
}
s_copy(text, "reset", 40L, 5L);
o__1.oerr = 0;
o__1.ounit = 50;
o__1.ofnmlen = 8;
o__1.ofnm = "test.dat";
o__1.orl = 0;
o__1.osta = 0;
o__1.oacc = 0;
o__1.ofm = "unformatted";
o__1.oblnk = 0;
f_open(&o__1);
s_rsue(&io___41);
do_uio(&c__1, text, 40L);
do_uio(&c__5, (char *)&j[0], (ftnlen)sizeof(integer));
do_uio(&c__5, (char *)&a[0], (ftnlen)sizeof(real));
e_rsue();
cl__1.cerr = 0;
cl__1.cunit = 50;
cl__1.csta = 0;
f_clos(&cl__1);
s_wsle(&io___42);
do_lio(&c__9, &c__1, "¥nRead the following data from file test.dat:¥n",
45L);
e_wsle();
s_wsfe(&io___43);
do_fio(&c__1, text, 40L);
for (i = 1; i <= 5; ++i) {
do_fio(&c__1, (char *)&j[i - 1], (ftnlen)sizeof(integer));
}
for (i = 1; i <= 5; ++i) {
do_fio(&c__1, (char *)&a[i - 1], (ftnlen)sizeof(real));
}
e_wsfe();
return 0;
} /* i_o_test__ */
/**************************************************************************/
/* Subroutine to do the integer math tests */
/**************************************************************************/
/* Subroutine */ int int_test__(integer *m)
{
/* Format strings */
static char fmt_203[] = "(10x,¥002n¥002,5x,¥002n^2¥002,5x,¥002n^3¥002,¥
5x,¥002n/2¥002,3x,¥002n^2/2¥002,3x,¥002n^3/2¥002)";
static char fmt_202[] = "(5x,6(i6,2x))";
/* System generated locals */
integer i__1, i__2, i__3, i__4;
/* Builtin functions */
integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
e_wsle(), s_wsfe(cilist *), e_wsfe(), do_fio(integer *, char *,
ftnlen);
/* Local variables */
static integer i, j, k;
/* Fortran I/O blocks */
static cilist io___44 = { 0, 6, 0, 0, 0 };
static cilist io___45 = { 0, 6, 0, fmt_203, 0 };
static cilist io___49 = { 0, 6, 0, fmt_202, 0 };
s_wsle(&io___44);
do_lio(&c__9, &c__1, "¥nGenerate a table of integers, squares, cubes, an¥
d their halves.¥n", 65L);
e_wsle();
s_wsfe(&io___45);
e_wsfe();
i__1 = *m;
for (i = 1; i <= i__1; ++i) {
/* Computing 2nd power */
i__2 = i;
j = i__2 * i__2;
/* Computing 3rd power */
i__2 = i, i__3 = i__2;
k = i__3 * (i__2 * i__2);
s_wsfe(&io___49);
do_fio(&c__1, (char *)&i, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&j, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
i__2 = i / 2;
do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
i__3 = j / 2;
do_fio(&c__1, (char *)&i__3, (ftnlen)sizeof(integer));
i__4 = k / 2;
do_fio(&c__1, (char *)&i__4, (ftnlen)sizeof(integer));
e_wsfe();
}
return 0;
} /* int_test__ */
/**************************************************************************/
/* Subroutine to do the floating point math tests */
/**************************************************************************/
/* Subroutine */ int flt_test__(integer *m)
{
/* Format strings */
static char fmt_205[] = "(12x,¥002x¥002,6x,¥002x^2¥002,6x,¥002x^3¥002,¥
6x,¥002x/2¥002,4x,¥002x^2/2¥002,4x,¥002x^3/2¥002)";
static char fmt_201[] = "(5x,6(f8.2,1x))";
/* System generated locals */
integer i__1;
real r__1, r__2, r__3;
/* Builtin functions */
integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
e_wsle(), s_wsfe(cilist *), e_wsfe(), do_fio(integer *, char *,
ftnlen);
/* Local variables */
static integer i;
static real x1, x2, x3;
/* Fortran I/O blocks */
static cilist io___50 = { 0, 6, 0, 0, 0 };
static cilist io___51 = { 0, 6, 0, fmt_205, 0 };
static cilist io___56 = { 0, 6, 0, fmt_201, 0 };
s_wsle(&io___50);
do_lio(&c__9, &c__1, "¥nGenerate a table of floats, their squares, cubes¥
, and their halves.¥n", 69L);
e_wsle();
s_wsfe(&io___51);
e_wsfe();
i__1 = *m;
for (i = 1; i <= i__1; ++i) {
x1 = i * (float)1.;
/* Computing 2nd power */
r__1 = x1;
x2 = r__1 * r__1;
/* Computing 3rd power */
r__1 = x1, r__2 = r__1;
x3 = r__2 * (r__1 * r__1);
s_wsfe(&io___56);
do_fio(&c__1, (char *)&x1, (ftnlen)sizeof(real));
do_fio(&c__1, (char *)&x2, (ftnlen)sizeof(real));
do_fio(&c__1, (char *)&x3, (ftnlen)sizeof(real));
r__1 = x1 / 2;
do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real));
r__2 = x2 / 2;
do_fio(&c__1, (char *)&r__2, (ftnlen)sizeof(real));
r__3 = x3 / 2;
do_fio(&c__1, (char *)&r__3, (ftnlen)sizeof(real));
e_wsfe();
}
return 0;
} /* flt_test__ */
/**************************************************************************/
/* Subroutine to do the algebraic function tests */
/**************************************************************************/
/* Subroutine */ int alg_test__(integer *m)
{
/* Format strings */
static char fmt_305[] = "(10x,¥002x¥002,7x,¥002SQRT(x)¥002,4x,¥002CURT¥
(x)¥002,3x,¥002SQRT(x)^2¥002,2x,¥002CURT(x)^3¥002)";
static char fmt_301[] = "(5x,6(f9.6,2x))";
/* System generated locals */
integer i__1;
real r__1, r__2, r__3, r__4, r__5;
doublereal d__1;
/* Builtin functions */
integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
e_wsle(), s_wsfe(cilist *), e_wsfe();
double sqrt(doublereal), pow_dd(doublereal *, doublereal *);
integer do_fio(integer *, char *, ftnlen);
/* Local variables */
static integer i;
static real x1, x2, x3;
/* Fortran I/O blocks */
static cilist io___57 = { 0, 6, 0, 0, 0 };
static cilist io___58 = { 0, 6, 0, fmt_305, 0 };
static cilist io___63 = { 0, 6, 0, fmt_301, 0 };
s_wsle(&io___57);
do_lio(&c__9, &c__1, "¥nGenerate a table of floats, square & cube roots,¥
and their squares & cubes.¥n", 77L);
e_wsle();
s_wsfe(&io___58);
e_wsfe();
i__1 = *m;
for (i = 1; i <= i__1; ++i) {
x1 = i * (float)1.;
x2 = sqrt(x1);
d__1 = (doublereal) x1;
x3 = pow_dd(&d__1, &c_b152);
s_wsfe(&io___63);
do_fio(&c__1, (char *)&x1, (ftnlen)sizeof(real));
do_fio(&c__1, (char *)&x2, (ftnlen)sizeof(real));
do_fio(&c__1, (char *)&x3, (ftnlen)sizeof(real));
/* Computing 2nd power */
r__2 = x2;
r__1 = r__2 * r__2;
do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real));
/* Computing 3rd power */
r__4 = x3, r__5 = r__4;
r__3 = r__5 * (r__4 * r__4);
do_fio(&c__1, (char *)&r__3, (ftnlen)sizeof(real));
e_wsfe();
}
return 0;
} /* alg_test__ */
/**************************************************************************/
/* Subroutine to do the transcendental function tests */
/**************************************************************************/
/* Subroutine */ int trn_test__()
{
/* Format strings */
static char fmt_207[] = "(9x,¥002x¥002,9x,¥002sin(x)¥002,8x,¥002cos(x¥
)¥002,4x,¥002sin(x)^2 + cos(x)^2¥002)";
static char fmt_200[] = "(5x,i2,¥002*pi/6¥0023x,f11.8,3x,f11.8,3x,f15.10)"
;
static char fmt_299[] = "(a1)";
static char fmt_208[] = "(11x,¥002x¥002,16x,¥002log(x)¥002,9x,¥002exp(lo¥
g(x))¥002)";
static char fmt_201[] = "(5x,f13.10,5x,f13.10,5x,f13.10)";
/* System generated locals */
doublereal d__1;
/* Builtin functions */
integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
e_wsle(), s_wsfe(cilist *), e_wsfe();
double sin(doublereal), cos(doublereal);
integer do_fio(integer *, char *, ftnlen), s_rsfe(cilist *), e_rsfe();
double log(doublereal), exp(doublereal);
/* Local variables */
static char junk[2];
static doublereal c;
static integer i;
static doublereal s, x, c2, s2, pi;
/* Fortran I/O blocks */
static cilist io___65 = { 0, 6, 0, 0, 0 };
static cilist io___66 = { 0, 6, 0, 0, 0 };
static cilist io___67 = { 0, 6, 0, fmt_207, 0 };
static cilist io___74 = { 0, 6, 0, fmt_200, 0 };
static cilist io___75 = { 0, 6, 0, 0, 0 };
static cilist io___76 = { 0, 5, 0, fmt_299, 0 };
static cilist io___78 = { 0, 6, 0, 0, 0 };
static cilist io___79 = { 0, 6, 0, fmt_208, 0 };
static cilist io___80 = { 0, 6, 0, fmt_201, 0 };
pi = (float)3.141592653589793;
s_wsle(&io___65);
do_lio(&c__9, &c__1, "¥nPart 1: Trig Functions", 23L);
e_wsle();
s_wsle(&io___66);
do_lio(&c__9, &c__1, "¥nGenerate a table of x, sin(x), cos(x) and the su¥
m of their squares.¥n", 69L);
e_wsle();
s_wsfe(&io___67);
e_wsfe();
for (i = 0; i <= 12; ++i) {
x = i * pi / (float)6.;
s = sin(x);
c = cos(x);
/* Computing 2nd power */
d__1 = s;
s2 = d__1 * d__1;
/* Computing 2nd power */
d__1 = c;
c2 = d__1 * d__1;
s_wsfe(&io___74);
do_fio(&c__1, (char *)&i, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&s, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&c, (ftnlen)sizeof(doublereal));
d__1 = s2 + c2;
do_fio(&c__1, (char *)&d__1, (ftnlen)sizeof(doublereal));
e_wsfe();
}
s_wsle(&io___75);
do_lio(&c__9, &c__1, "¥nPart 2: Exponential functions; hit return to co¥
ntinue...", 58L);
e_wsle();
s_rsfe(&io___76);
do_fio(&c__1, junk, 2L);
e_rsfe();
s_wsle(&io___78);
do_lio(&c__9, &c__1, "Generate a table of x, log(x), and exp(log(x))¥n",
47L);
e_wsle();
s_wsfe(&io___79);
e_wsfe();
for (i = 1; i <= 10; ++i) {
x = (doublereal) i;
s = log(x);
c = exp(s);
s_wsfe(&io___80);
do_fio(&c__1, (char *)&x, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&s, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&c, (ftnlen)sizeof(doublereal));
e_wsfe();
}
return 0;
} /* trn_test__ */
/* Main program alias */ int test_f2c__ () { MAIN__ (); return 0; }
#ifdef __cplusplus
}
#endif